home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue35 / MultiSel / ProgressFrm.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1998-03-25  |  2.3 KB  |  111 lines
  1. unit ProgressFrm;
  2.  
  3. interface
  4. {$D-}
  5. uses
  6.     Windows, Classes, SysUtils, Controls, Forms, Gauges, StdCtrls, ExtCtrls;
  7.  
  8. type
  9.     EProgressError=Exception;
  10.  
  11.     TfrmProgress = class(TForm)
  12.         Gauge1: TGauge;
  13.         Label1: TLabel;
  14.         Bevel1: TBevel;
  15.         procedure FormKeyDown(Sender: TObject; var Key: Word;
  16.             Shift: TShiftState);
  17.         procedure FormShow(Sender: TObject);
  18.         procedure FormCreate(Sender: TObject);
  19.     private
  20.         { Private declarations }
  21.         function    GetMax:LongInt;
  22.         function    GetProgress:LongInt;
  23.         procedure    SetMax(value:LongInt);
  24.         procedure    SetProgress(value:LongInt);
  25.     protected
  26.         procedure    SetDesc(const value:string);
  27.         function    GetDesc:string;
  28.     public
  29.         { Public declarations }
  30.         procedure    Inc;
  31.     published
  32.         property    Max:Longint read GetMax write SetMax default 100;
  33.         property    Progress:LongInt read GetProgress write SetProgress;
  34.         property    JobDescription:string read GetDesc write SetDesc;
  35.     end;
  36.  
  37. var
  38.     frmProgress: TfrmProgress;
  39.  
  40. implementation
  41.  
  42. {$R *.DFM}
  43.  
  44. procedure    TfrmProgress.SetDesc(const value:string);
  45. begin
  46.     Label1.Caption:=value;
  47. end;
  48.  
  49. function    TfrmProgress.GetDesc:string;
  50. begin
  51.     result:=Label1.Caption;
  52. end;
  53.  
  54. function    TfrmProgress.GetMax:LongInt;
  55. begin
  56.     Result:=Gauge1.MaxValue;
  57. end;
  58.  
  59. function    TfrmProgress.GetProgress:LongInt;
  60. begin
  61.     Result:=Gauge1.Progress;
  62. end;
  63.  
  64. procedure    TfrmProgress.Inc;
  65. begin
  66.     SetProgress(Gauge1.Progress+1);
  67. end;
  68.  
  69. procedure    TfrmProgress.SetProgress(value:LongInt);
  70. begin
  71.     Gauge1.Progress:=Value;
  72.     Application.ProcessMessages;
  73. end;
  74.  
  75. // This procedure is provided for hooking to Apollo.
  76. procedure TfrmProgress.FormKeyDown(Sender: TObject; var Key: Word;
  77.     Shift: TShiftState);
  78. var
  79.     wVal : Word;
  80. begin
  81.     if (Key and $7000) <> 0 then
  82.     begin
  83.         wVal := -Word( Key );
  84.         Gauge1.Progress := wVal;
  85.         Application.ProcessMessages;
  86.         Key := 0;
  87.     end;
  88. end;
  89.  
  90. procedure    TfrmProgress.SetMax(value:LongInt);
  91. begin
  92.     if not (value>0) then
  93.         raise EProgressError.Create('Progress Bar Range: Max <= 0');
  94.     Gauge1.MaxValue:=Value;
  95. end;
  96.  
  97. procedure TfrmProgress.FormShow(Sender: TObject);
  98. begin
  99.     Left:=Screen.Width-Width-10;
  100.     Top:=Screen.Height-Height-10;
  101.     Gauge1.Progress:=0;
  102.     application.processmessages;
  103. end;
  104.  
  105. procedure TfrmProgress.FormCreate(Sender: TObject);
  106. begin
  107.     Gauge1.MaxValue:=100;
  108. end;
  109.  
  110. end.
  111.